home *** CD-ROM | disk | FTP | other *** search
/ START Magazine / START VOL 3 NO 7.st / VCR_ORG.ARC / SUBR_MOD.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-11-11  |  6.7 KB  |  271 lines
  1. {$M+}
  2. {$E+}
  3.  
  4. program Module_2;
  5.  
  6. {$I A:GEMSUBS.PAS }
  7. {$I A:AUXSUBS.PAS }
  8.  
  9.   Const
  10.        {$I B:VCR_Cnst.Pas }
  11.  
  12.   Type
  13.        {$I B:VCR_Type.Pas }
  14.  
  15.  
  16.   Var
  17.        {$I B:VCR_Var.Pas }
  18.  
  19.  
  20. { -- No External Procedures -- }
  21.  
  22.  
  23.   procedure WSlide_Size(Max_Scr, Total_Dsply, Wind_Number : integer);
  24.  
  25.      begin
  26.        if Total_Dsply <= Max_Scr then Slide_Size := 1000
  27.        else
  28.           Slide_Size := (1000 * Max_Scr) DIV Total_Dsply;
  29.        Wind_Set(Wind_Handle[Wind_Number], WF_VSlSize, Slide_Size, Dummy,
  30.                 Dummy, Dummy);
  31.      end;
  32.  
  33.  
  34.   procedure Paint_Frame( x, y, w, h, color, pattern : integer ) ;
  35.  
  36.    begin
  37.      Draw_Mode(1);
  38.      Paint_Color(color);
  39.      Paint_Style(pattern);
  40.      Paint_Rect(x, y, w, h);
  41.      Frame_Rect(x, y, w, h);
  42.    end;
  43.  
  44.  
  45.   procedure Empty_Line(X, Y, Z : integer);
  46.  
  47.    var
  48.        i : integer;
  49.  
  50.    begin
  51.      for i := 0 to Z - 1 do
  52.          Draw_String(X + 8 * i, Y, Sp);
  53.    end;
  54.  
  55.  
  56.   procedure Trail_Sp( Var S : Name ) ;
  57.  
  58.     var
  59.         Last_Char : string;
  60.  
  61.     begin
  62.       repeat
  63.         Len := Length(S);                 { Remove trailing spaces }
  64.         if Len > 0 then
  65.            Last_Char := Copy(S, Len, 1);
  66.         if Last_Char = Sp then
  67.            Delete(S, Len, 1);
  68.       until Last_Char <> Sp;
  69.     end;
  70.  
  71.  
  72. procedure DateStr(Input_Integer : integer; Var Output_String : string);
  73.  
  74.  Var
  75.          First_Number : integer;
  76.          Input_Save   : integer;
  77.          First_Char   : char;
  78.  
  79.  begin
  80.    Input_Save := Input_Integer;
  81.    First_Number := 0;
  82.    Output_String := No_Sp;
  83.  
  84.    if Input_Integer > 999 then
  85.       begin
  86.         First_Number := Input_Integer DIV 1000;
  87.         First_Char   := Chr(First_Number + $30);
  88.         Output_String := Concat(Output_String, First_Char);
  89.         Input_Integer := Input_Integer - (First_Number * 1000);
  90.      end
  91.    else
  92.       if Input_Save > 999 then
  93.          Output_String := Concat(Output_String,'0')
  94.       else
  95.          Output_String := Concat(Output_String,' ');
  96.  
  97.  
  98.    if Input_Integer > 99 then
  99.       begin
  100.         First_Number := Input_Integer DIV 100;
  101.         First_Char   := Chr(First_Number + $30);
  102.         Output_String := Concat(Output_String, First_Char);
  103.         Input_Integer := Input_Integer - (First_Number * 100);
  104.       end
  105.    else
  106.       if Input_Save > 99 then
  107.          Output_String := Concat(Output_String,'0')
  108.       else
  109.          Output_String := Concat(Output_String,' ');
  110.  
  111.    if Input_Integer > 9 then
  112.       begin
  113.         First_Number := Input_Integer DIV 10;
  114.         First_Char   := Chr(First_Number + $30);
  115.         Output_String := Concat(Output_String, First_Char);
  116.         Input_Integer := Input_Integer - (First_Number * 10);
  117.       end
  118.    else
  119.        if Input_Save > 9 then
  120.           Output_String := Concat(Output_String,'0')
  121.        else
  122.           Output_String := Concat(Output_String,' ');
  123.  
  124.  
  125.    First_Char  := Chr(Input_Integer + $30);
  126.    Output_String := Concat(Output_String, First_Char);
  127.  
  128.  end;
  129.  
  130.  
  131.  procedure Text_Box(X, Y, Z : integer ; S : string) ;
  132.  
  133.   var
  134.     Len : integer;
  135.  
  136.   begin
  137.     Len := Length(S);
  138.     if S = Sp then
  139.        Z := Z + 1
  140.     else
  141.        Z := Len + 1;
  142.     Paint_Frame(X, Y, Z * 8, 10 * Resolution, White, 0);
  143.     Draw_String(X + 4, Y + 8 * Resolution, S);
  144.   end;
  145.  
  146.  
  147.  
  148.  procedure Erase_Cursor;
  149.  
  150.   var
  151.      Len : integer;
  152.  
  153.   begin
  154.     if (Module = Wind_Handle[1]) AND (Field > 0) then
  155.         begin
  156.           Len := Length(Input_String[Field]);
  157.           Hide_Mouse;
  158.           Draw_String(x0 + XY_VCR[1,Field] + 8 * Len,
  159.                       y0 + XY_VCR[2,Field] * Resolution, Sp);
  160.           Show_Mouse;
  161.         end;
  162.   end;
  163.  
  164.  
  165.  procedure New_Cursor;
  166.  
  167.   var
  168.      Len : integer;
  169.  
  170.    begin
  171.      if (Module = Wind_Handle[1]) AND (Field > 0) then
  172.         begin
  173.           Hide_Mouse;
  174.           Len := Length(Input_String[Field]);
  175.           X_Cursor := x0 + XY_VCR[1,Field] + 8 * Len;
  176.           Y_Cursor := y0 + XY_VCR[2,Field] * Resolution;
  177.           Draw_String(X_Cursor, Y_Cursor, UnderLine);
  178.           Show_Mouse;
  179.         end;
  180.    end;
  181.  
  182.  
  183. procedure Val(S: String; Var Result : integer; Var Error  : Boolean);
  184.  
  185. var
  186.      Space_Pos  : string[1];
  187.      Len        : integer;
  188.      S_Result   : String[1];
  189.      LI_Result  : integer;
  190.      Multiplier : integer;
  191.      i, j       : integer;
  192.      minus      : Boolean;
  193.      Minus_Pos  : integer;
  194.      Size_Check : string[1];
  195.      Space      : string;
  196.  
  197.  
  198. begin
  199.      Minus_Pos := Pos(Chr($2D), S);
  200.      if Minus_Pos > 0 then
  201.         begin
  202.           Delete(S, Minus_Pos, 1);
  203.           Minus := True;
  204.         end
  205.      else
  206.         Minus := False;
  207.  
  208.      repeat
  209.        Len := Length(S);
  210.        if Len > 0 then
  211.           begin
  212.             Space := Copy(S,1,1);
  213.             if Space = Sp then
  214.                Delete(S,1,1);
  215.           end;
  216.      Until Space <> Sp;
  217.  
  218.      Len := Length(S);
  219.      if Len > 0 then
  220.         begin
  221.           Size_Check := Copy(S, 1, 1);
  222.           if (Len < 5) OR ((Len = 5) AND ((Size_Check = '1')
  223.                                       OR (Size_Check = '2'))) then
  224.                 Error := False
  225.           else
  226.              Error := True;
  227.  
  228.           Result := 0;
  229.           for i := 1 to Len do
  230.           if NOT (Error) then
  231.             begin
  232.                S_Result := Copy(S,1,1);
  233.                Delete(S,1,1);
  234.                 if S_Result = '0' then LI_Result := 0
  235.                 else
  236.                   if S_Result = '1' then LI_Result := 1
  237.                  else
  238.                     if S_Result = '2' then LI_Result := 2
  239.                     else
  240.                       if S_Result = '3' then LI_Result := 3
  241.                       else
  242.                         if S_Result = '4' then LI_Result := 4
  243.                         else
  244.                           if S_Result = '5' then LI_Result := 5
  245.                           else
  246.                             if S_Result = '6' then LI_Result := 6
  247.                             else
  248.                               if S_Result = '7' then LI_Result := 7
  249.                               else
  250.                                 if S_Result = '8' then LI_Result := 8
  251.                                 else
  252.                                   if S_Result = '9' then LI_Result := 9
  253.                                   else
  254.                                     Error := True;
  255.                if NOT (Error) then
  256.                  begin
  257.                     Multiplier := 1;
  258.                     for j := 1 to Len - i do
  259.                         Multiplier := Multiplier * 10;
  260.                     LI_Result := Multiplier * LI_Result;
  261.                     Result := Result + LI_Result;
  262.                  end;
  263.             end;
  264.           if Minus then Result := Result * (-1);
  265.         end;
  266. end;
  267.  
  268.  
  269. BEGIN
  270. END.
  271.